COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE WRTPAG
C00021 ENDMK
C⊗;
	SUBROUTINE WRTPAG
	DATA SLSP/12.0/
	COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
	1 /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG
	1 ,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) 
	1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
	COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
	COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/OSLUR(1)
	COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
	1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(1)
	DIMENSION ENDSTF(450),ENDPTR(50)
C  ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
	1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,OSLUR(80)),(NDPY,OSLUR(81))
	1,(LASTNM,KBAR(3)),(ENDSTF,KBAR(4)),(ENDSTF,KBAR(460))
	NMPG='PAGEA'
	LB=0
	TR=LL
C TRANSPOSE?  IN LL
	RA=0
811	JEND=-1
	METR=1000
	CLEF=-99
CC	J=0
	JSLUR=0
	LC=1
	KREAD=128
	SIG=CLEF
	HX=2
	KQ=1
	KPX=1
	CALL FILOUT(NAMQ,NPG)
	SP=2.45
C  DEFAULT VERT. SPACE UNITS
	IF(N.EQ.0)GO TO 100
C  SPACED OUT DEPENDING ON NUM OF LINES
	HX=N
	SP=SP+(HX-2.)*.11
CC100	IF(NMPG.GT.LASTNM)CALL EXIT
CC	KK=1
CC	I=0

100	CALL FILEIN

320	IF(TR.NE.0)CALL TRNSP(L,TR)
	CALL STAVES
CP	KB=KL
	JPQ=KL

	NA=0
C  LOOP STARTS HERE *******
131	NA=NA+1
CP131	DO 30 NA=KK,K
	KWDS(KP)=JPQ
	KP=KP+1
	JK=KPN(NA)
	R=Q(JK+1)
	IF(R.EQ.5)GO TO 135
	IF(R.NE.44)GO TO 35
135	RR=Q(JK+6)
	IF(RR.LT.Q(JK+3))GO TO 635
C  NEEDED WHEN DATA ON LINE HAS BEEN EXPANDED, NOT CONTRACTED.
	IF(RR.LT.199.)GO TO 37
	GO TO 235
C CATCHES END OF SLUR AND VARIOUS LINES
635	IF(R.NE.5)GO TO 37
C  TO PUT SLUR ON NEXT LINE.
C*********** IS SOMETHING MISSING HERE????????  4/76
235	IF(JSLUR.NE.0)GO TO 435
	JSLUR=-1
	K4=2
	K5=3
	K7=4
	K2=1
	GO TO 535
C FOR 2ND SLUR
435	K4=6
	K5=7
	K7=8
	K2=5
	JSL2=-1
535	OSLUR(K2)=Q(JK+2)
	OSLUR(K4)=Q(JK+4)
	OSLUR(K5)=Q(JK+5)
	OSLUR(K7)=Q(JK+7)
C  SAVES SLUR, ETC. INFO FOR NEXT LINE
	RR=201
	IF(Q(JK+8).LT.-1)RR=202
	Q(JK+6)=RR
	IF(R.EQ.5)GO TO 30
	GO TO 38

35	IF(R.NE.2)GO TO 36
	IF(Q(JK).LT.6.)GO TO 30
	RR=RIGHT(NA,-1)
	IF(RR.GE.199.)RR=RX
	Q(JK+3)=RR-1.6*RSTJ2+(RIGHT(NA,1)-RR)/2.
C  FUNCTION 'RIGHT' FINDS RIGHT ITEMS FOR CENTERING.
C CENTERS WHOLE REST
	GO TO 30
36	IF(R.NE.3)GO TO 34
	CLEF=CLEFN(Q,JK)
	IF(IPG)GO TO 30  
	LL=Q(JK+2)
C GETS CLEF FOR PAGE LAYOUT
	RCLEF(LL)=CLEF
	GO TO 30
34	IF(R.NE.17)GO TO 37
	SIG=Q(JK+5)
	IF(ABS(SIG).GT.100.)SIG=-99
C  DO NOT REPEAT KSIG MADE UP OF NATURALS.
CXX	IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
CXX  CLEF # IN P6 WITH KEY SIGS.
C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
37	IF(R.LT.33)GO TO 30
38	Q(JK+1)=R/11.
	IF(R.NE.18)GO TO 30
	IF(NA.LT.METR)GO TO 30
C TO ADD METER AT END OF BAR
	LL=KPN(K+1)
	RS=Q(LL+1)
	IF(RS.LE.4)GO TO 3
	R4=Q(LL+2)
C  SAVE THE STAFF NUM. IN RX
	IF(RS.NE.18)GO TO 7011
	MTR1=0 
	OSLUR(9)=Q(LL+5)
	OSLUR(10)=Q(LL+6)
C WHAT ABOUT REHRSL NUMS, ETC??
7011	LL=KPN(K+2)
	RS=Q(LL+1)
	IF(RS.LE.4)GO TO 3
	IF(IPG)GO TO 4011
	IF(Q(LL+2).NE.R4)GO TO 4111
4011	IF(RS.NE.18)GO TO 8011
	MTR2=0 
	OSLUR(11)=Q(LL+5)
	OSLUR(12)=Q(LL+6)
8011	LL=KPN(K+3)
	IF(IPG)GO TO 4211
	IF(Q(LL+2).NE.R4)GO TO 4111
4211	IF(Q(LL+1).NE.18)GO TO 4111
	MTR2=0 
	OSLUR(11)=Q(LL+5)
	OSLUR(12)=Q(LL+6)
4111	IF(MTR1.GE.0)GO TO 3
	OSLUR(9)=OSLUR(11)
	OSLUR(10)=OSLUR(12)
	MTR2=-1
C IN CASE IT SAW SOMETHING AHEAD OF NEW METER
	Q(JK+3)=200+Q(JK+3)-REND
C  PUTS METER AFTER END OF LINE.
3	CONTINUE
30	JPQ=KPN(NA+1)-KPN(NA)+JPQ
	IF(NA.LT.I)GO TO 131
C  END OF LOOP ****************

	CALL PSHFT(I)
	RS=RT
	LL='J'
	R4=0
	R5=200
	NA=L
	L=KP-1 
	CALL PTMOVE(RN,KWDS(1))

C  START LAST LOOP *******
	DO 47 JJ2=1,KP
	LL=KWDS(JJ2)
	AA=RN(LL+1)
	IF(AA.NE.10.AND.AA.NE.16)GO TO 347
	DO 147 NN=JJ2+1,KP
	MM=KWDS(NN)
	IF(RN(MM+1).NE.16)GO TO 147
C  FOUND THE NEXT TEXT AFTER TEXT OR NUMB.
	IF(RN(MM).EQ.8)GO TO 47
C  JUMP IF POS. IS ALREADY TAKEN CARE OF.
	IF(AA.EQ.10)GO TO 247
C NEXT FOR TEXT FOLLOWING TEXT
	IF(ABS(RN(MM+4)-RN(LL+4)).GE.4)GO TO 47
C JUMP IF ON DIFF. VERT. PLANE.
	AA=(RN(LL+9)+4.)*RSTJ2*RN(LL+5)+RN(LL+3)
C  SETS MINIMUM SPACE.
	IF(RN(MM+3).LT.AA)RN(MM+3)=AA
	GO TO 47
247	IF(ABS(RN(MM+4)-RN(LL+4)).GT.6)GO TO 47
C  CHECKS VERT. POS.
	AA=RN(LL+4)+7
	IF(RN(MM+4)-AA.LT.0)RN(MM+4)=AA
C  MOVE WORD TO RIGHT OF NUMBER IF IT WAS TOO CLOSE
	GO TO 47
147	CONTINUE
	GO TO 47
347	IF(AA.NE.5)GO TO 1047
C TO IMPROVE SLUR PARAMETERS
	R8=RN(LL+8)
	IF(RN(LL).LT.6)R8=0
	IF(R8.GT.0)GO TO 47
C  JUMP IF A BRACKET
	R=RN(LL+6)

	DO 647 NN=JJ2+1,KP
	MM=KWDS(NN)
C  THIS IS TO FIND SLURS AT END OF OLD LINES AND EXTEND THEM
	IF(RN(MM+1).NE.4)GO TO 647
C FIND A BAR LINE
	IF(RN(MM+3).GT.199.)GO TO 647
C  IGNORE LAST BAR OR LINE.
	IF(RN(MM).GT.2)GO TO 647
	AA=ABS(RN(MM+3)-R)
	IF(AA.GT.1.)GO TO 647
	RN(LL+6)=R+4
	GO TO 47
647	CONTINUE

	R7=RN(LL+7)
	R9=R-RN(LL+3)+(R8+1.)*2.
	IF(R9.GT.7)GO TO 47
C  NO WORK NEEDED.  IT'S LONG ENOUGH
	IF(RN(LL).GT.5)RN(LL+8)=-1
	R=1.
	IF(R7.LT.0)R=-R
547	RN(LL+4)=RN(LL+4)+R
	RN(LL+5)=RN(LL+5)+R
C  WERE +AA ↑↑↑↑↑
	RN(LL+7)=R
	GO TO 47
1047	IF(AA.NE.6)GO TO 47
	IF(RN(LL).LT.7)GO TO 47
	IF(RN(LL+9).GT.200.)RN(LL+9)=0
C ********** FIX THIS IN GETPTS, MOVER.  IT SHOULDN'T MOVE P9 ALWAYS.
47	CONTINUE

2	KWDS(KP)=JPQ
CP	J=1
	IF(KP.GE.250.OR.JPQ.GE.2000)TYPE 20,KP,JPQ
	JJ2=KP+1
C  WRITES 1 EXTRA WORD
CP	JPQ=KB
	CALL PUTFIL(NAMX)
	LCNT=0
	NDPY=0
	RSTFAC(96)=0
C  MUST BE 0 IN MS TO MAKE DISPLAY
	CALL FASTOU(RSTFAC,128)
	CALL FASTOU(KWDS,JJ2)
	CALL FASTOU(RN,JPQ)
	TYPE 101,NAMX
	NAMX=NAMX+2
	IF(IPG)GO TO 6011
	NPG=NPG+1
	IF(NPG.LE.MPG)GO TO 6011
	NPG=1
C RESET, UPDATE FILENAMES
	NAMX=NAMZ+256
	NAMZ=NAMX
6011	NAMQ=NAMX
	CALL FINFIL
	GO TO 100
101	FORMAT(1XA5)
20	FORMAT(' TOO MUCH DATA!!! ',I3,'/250',I5,'/2000')
	END